4 Socialna omrežja in podnapisi
Primer preprostega animiranega zemljevida, ki prikazuje časovni potek čivkov o smrti bobnarja rockovske skupine Rolling Stones, Charlieja Wattsa. Zajeti so bili čivki v devetdnevnem obdobju v angleščini, nemščini in slovenščini. Petrič 2022
Show the code
knitr::include_graphics("pictures/rolling_stones_tweets_animated.gif")
4.1 Nalaganje knjižnic
Show the code
library(tidyverse)
library(tidytext)
library(readxl)
library(writexl)
library(quanteda)
library(quanteda.textstats)
library(quanteda.textplots)
library(rtweet)
library(Twitmo)
library(ndjson)
library(plotly)
library(lubridate)
library(igraph)
library(textfeatures)
library(ggwordcloud)4.2 Poizvedbe v omrežju Twitter
4.2.1 Preverjanje pristnosti (avtentikacija)
Za poizvedbe se morate najprej prijaviti na Twitterjevem programskem vmesniku (API).
Za poizvedbe je treba ustvariti Twitter App <apps.twitter.com>. Opis: gl. https://mkearney.github.io/nicar_tworkshop/#10.
Najpreprostejša prijava z lastno Twitterjevo aplikacijo poteka z naslednjim ukazom:
Show the code
rtweet::auth_setup_default()R pošilja vaš čivk.
Show the code
post_tweet(paste0("My first tweet with #rtweet #rstats at ", Sys.time()))Nekaj koristnih naslovov s “kuharskimi” recepti za poizvedovanje v socialnem omrežju Twitter:
https://cran.r-project.org/web/packages/rtweet/vignettes/rtweet.html
https://mkearney.github.io/nicar_tworkshop/#1
https://www.gbailey.uk/twitter_workshop/pt2_collection.html
https://rpubs.com/vivvi87/rtweet_notes
https://predictivehacks.com/how-to-get-twitter-data-using-r/
4.2.2 Sprotne poizvedbe
4.2.2.1 Prijatelji
Pridobi id prijateljev navedene osebe s funkcijo get_friends() knjižnice rtweet, tj. katerim uporabnikom navedena oseba sledi.
Show the code
prijatelji_jj <- get_friends("jjansasds")
prijatelji_al <- get_friends("anzelog")
saveRDS(prijatelji_jj, "data/twitter/politiki/prijatelji_jansa.rds")
saveRDS(prijatelji_al, "data/twitter/politiki/prijatelji_logar.rds")Odpiramo shranjeno poizvedbo.
Show the code
prijatelji_jj <- read_rds("data/twitter/politiki/prijatelji_jansa.rds")
prijatelji_al <- read_rds("data/twitter/politiki/prijatelji_logar.rds")
dim(prijatelji_jj)[1] 4080 2
Show the code
dim(prijatelji_al)[1] 959 2
Janez Janša sledi 4060 uporabnikom, Anže Logar pa 959 uporabnikom.
Kateri prijatelji so skupni oz. katerim uporabnikom sledita oba politika? To lahko hitro ugotovimo s funkcijo intersect().
Show the code
prijatelji_skupni <-
intersect(prijatelji_jj$to_id, prijatelji_al$to_id) %>%
as_tibble_col(column_name = "skupni_prijatelji")
dim(prijatelji_skupni)[1] 557 1
Mnogim uporabnikom, ki jim sledi Anže Logar (tj. 557 od 959), sledi tudi Janez Janša.
Kateri so ti skupni prijatelji? To lahko ugotovimo s funkcijo lookup_users().
Show the code
prijatelji_jj_data <- lookup_users(prijatelji_jj$to_id)
prijatelji_al_data <- lookup_users(prijatelji_al$to_id)
saveRDS(prijatelji_jj_data, "data/twitter/politiki/prijatelji_jansa_data.rds")
saveRDS(prijatelji_al_data, "data/twitter/politiki/prijatelji_logar_data.rds")Odpiramo shranjeno poizvedbo.
Show the code
prijatelji_jj_data <- read_rds("data/twitter/politiki/prijatelji_jansa_data.rds")
prijatelji_al_data <- read_rds("data/twitter/politiki/prijatelji_logar_data.rds")
dim(prijatelji_jj_data)[1] 4079 23
Show the code
dim(prijatelji_al_data)[1] 959 23
Show the code
prijatelji_skupni_data <-
intersect(prijatelji_jj_data$name, prijatelji_al_data$name) %>%
as_tibble_col(column_name = "imena_skupnih_prijateljev")
dim(prijatelji_skupni_data)[1] 562 1
Poizvedba nam je dala 562 skupnih prijateljev. Tu so imena:
Show the code
prijatelji_skupni_data %>%
rmarkdown::paged_table()Skupni prijatelji so lahko npr. povezani z izbiro pogovorne tematike, značilnih izrazov itd.
4.2.2.2 Sledilci
Ukaz get_followers() nam omogoča najti sledilce navedenega uporabnika.
Show the code
npmusar_sledilci <- get_followers("nmusar",
retryonratelimit = TRUE)
npmusar_sledilci_data <- lookup_users(npmusar_sledilci$from_id)
saveRDS(npmusar_sledilci, "data/twitter/politiki/npmusar_sledilci.rds")
saveRDS(npmusar_sledilci_data, "data/twitter/politiki/npmusar_sledilci_data.rds")Odpiramo shranjeno poizvedbo.
Show the code
npmusar_sledilci_data <- read_rds("data/twitter/politiki/npmusar_sledilci_data.rds")
dim(npmusar_sledilci_data)[1] 5000 23
Show the code
npmusar_sledilci_data %>% rmarkdown::paged_table()Show the code
npmusar_sledilci_data %>%
filter(str_detect(name, "Janša")) %>%
rmarkdown::paged_table()4.2.2.3 Iskanje čivkov
Funkcija search_tweets() nam vrne tabelo čivkov z ozirom na tematsko vprašanje.
Show the code
q <- "ukrajina"
ukraijina <- search_tweets(q = q,
n = 1000,
# token = rtweet_app(bearer_token$access_token),
include_rts = FALSE,
`-filter` = "replies",
lang = "sl"
)
saveRDS(ukraijina,
"data/twitter/politiki/ukraijina_tweets_sl.rds")Odpiramo shranjeno poizvedbo.
Show the code
ukraijina <- read_rds(
"data/twitter/politiki/ukraijina_tweets_sl.rds")
dim(ukraijina)[1] 101 43
4.2.2.4 Časovnica
Privzeto 100 čivkov, zgornja meja n = 3200. Še več, če pridobil bearer_token.
Show the code
fajon_timeline <- get_timeline("tfajon", n = 3200)
saveRDS(fajon_timeline, "data/twitter/politiki/fajon_timeline.rds")Odpiramo shranjeno poizvedbo.
Show the code
fajon_timeline <-
read_rds("data/twitter/politiki/fajon_timeline.rds")Show the code
tline_plot_fajon <- fajon_timeline |>
filter(created_at > "2022-01-01") |>
ts_plot(by = "weeks", trim = 1L, color = "magenta") +
geom_point() +
theme_minimal() +
theme(
legend.title = element_blank(),
legend.position = "bottom",
plot.title = element_text(face = "bold")) +
labs(
x = NULL, y = NULL,
title = "Frequency of Twitter statuses by Tanja Fajon",
subtitle = "Twitter status counts aggregated by weeks from 2022",
caption = "Source: Data collected from Twitter's REST API via rtweet"
)
library(plotly)
ggplotly(tline_plot_fajon)4.2.2.5 Priljubljeni čivki
Pridobiti želimo 10 zadnjih priljubljenih čikov Tanje Fajon in Mateja Tonina.
Show the code
favorit_fajon <- get_favorites("tfajon", n = 10)
favorit_tonin <- get_favorites("MatejTonin", n = 10)
saveRDS(favorit_fajon, "data/twitter/politiki/fajon_favorit.rds")
saveRDS(favorit_tonin, "data/twitter/politiki/tonin_favorit.rds")Odpiramo shranjeno poizvedbo.
Show the code
favorit_fajon <-
read_rds("data/twitter/politiki/fajon_favorit.rds")
favorit_tonin <-
read_rds("data/twitter/politiki/tonin_favorit.rds")Show the code
favorit_fajon %>%
select("text", "created_at", "id_str") %>%
rmarkdown::paged_table()Show the code
favorit_tonin %>%
select("text", "created_at", "id_str") %>%
rmarkdown::paged_table()4.2.2.6 Poglej izbrane čivke
Kontroverzni čivki Donalda Trumpa.
Show the code
## status IDs
status_ids <- c("947235015343202304", "947592785519173637",
"948359545767841792", "832945737625387008")
## lookup tweets
twt <- lookup_tweets(status_ids)Kontroverzni čivki Janeza Janša.
Jansa’s tweet, Carpenter’s reaction and Fazlic commenting on Carpenter’s reaction
Show the code
# status_id = "1319567043218296833" (Jansa's suport from Trump)
status = "1320064582170398722" # Comment on Carpenter's tweet by Damir Fazlić
tw1 <- lookup_statuses(status)
tw1# A tibble: 1 × 43
created_at id id_str full_…¹ trunc…² displ…³ entities source
<dttm> <dbl> <chr> <chr> <lgl> <dbl> <list> <chr>
1 2020-10-24 20:08:16 1.32e18 13200… "Micha… FALSE 263 <named list> "<a h…
# … with 35 more variables: in_reply_to_status_id <lgl>,
# in_reply_to_status_id_str <lgl>, in_reply_to_user_id <lgl>,
# in_reply_to_user_id_str <lgl>, in_reply_to_screen_name <lgl>, geo <list>,
# coordinates <list>, place <list>, contributors <lgl>,
# is_quote_status <lgl>, quoted_status_id <dbl>, quoted_status_id_str <chr>,
# quoted_status_permalink <list>, retweet_count <int>, favorite_count <int>,
# favorited <lgl>, retweeted <lgl>, possibly_sensitive <lgl>, lang <chr>, …
Janša’s provocative tweet
Show the code
# status_id = "1319567043218296833" (Jansa's suport for Trump)
status = "1319567043218296833"
tw <- lookup_statuses(status)
tw# A tibble: 1 × 43
created_at id id_str full_…¹ trunc…² displ…³ entities source
<dttm> <dbl> <chr> <chr> <lgl> <dbl> <list> <chr>
1 2020-10-23 11:11:14 1.32e18 13195… "We re… FALSE 279 <named list> "<a h…
# … with 35 more variables: in_reply_to_status_id <lgl>,
# in_reply_to_status_id_str <lgl>, in_reply_to_user_id <lgl>,
# in_reply_to_user_id_str <lgl>, in_reply_to_screen_name <lgl>, geo <list>,
# coordinates <list>, place <list>, contributors <lgl>,
# is_quote_status <lgl>, retweet_count <int>, favorite_count <int>,
# favorited <lgl>, retweeted <lgl>, lang <chr>, possibly_sensitive <list>,
# quoted_status <list>, text <chr>, favorited_by <lgl>, scopes <lgl>, …
Show the code
# status_id = "1324075189802512384" (Jansa: lefties can't stand Trump is winner)
# status_id = "1323913419200864256" (Jansa: Trump is winner)
status2 = "1323913419200864256"
tw2 <- lookup_statuses(status2)
tw2# A tibble: 1 × 43
created_at id id_str full_…¹ trunc…² displ…³ entities source
<dttm> <dbl> <chr> <chr> <lgl> <dbl> <list> <chr>
1 2020-11-04 10:02:10 1.32e18 13239… It’s p… FALSE 253 <named list> "<a h…
# … with 35 more variables: in_reply_to_status_id <lgl>,
# in_reply_to_status_id_str <lgl>, in_reply_to_user_id <lgl>,
# in_reply_to_user_id_str <lgl>, in_reply_to_screen_name <lgl>, geo <list>,
# coordinates <list>, place <list>, contributors <lgl>,
# is_quote_status <lgl>, retweet_count <int>, favorite_count <int>,
# favorited <lgl>, retweeted <lgl>, possibly_sensitive <lgl>, lang <chr>,
# quoted_status <list>, text <chr>, favorited_by <lgl>, scopes <lgl>, …
Poizvedba s 5. novembra 2020.
Show the code
# status_id = "1323913419200864256" (Jansa's claim that Trump is winner of elections)
tweets_replies_jj_support2 <- search_tweets(q = "1323913419200864256",
n = 18000,
include_rts = FALSE,
`-filter` = "replies",
lang = "en")Shranjena poizvedba s 5. novembra 2020.
Show the code
tweets_replies_jj_support2 <- read_rds("data/twitter/politiki/replies_to_jj_support_for_trump.rds")
tweets_replies_jj_support2 %>%
select(text, created_at, name, screen_name) %>%
rmarkdown::paged_table()4.2.2.7 Streaming – Tok v živo
Show the code
library(Twitmo)
library(ndjson)
## random sample
nakljucen_tok <- get_tweets(method = 'stream',
location = "SLV",
timeout = 30,
file_name = "data/slv_tweet_stream.json")Show the code
nakljucen_tok <- ndjson::stream_in("data/slv_tweet_stream.json")
nakljucen_tok[1:10] %>%
select(text) text
1: @german_erazo Sa mierddd.
2: Responde de inmediato #MAR para el 1-1 en 9 minutos.\n\n¿Nos espera un gran partido por el tercer lugar?
3: Khaaaaaaaaaa 😳
4: @valentgarzonc Que mujerón !!!
5: Borracho pero responsable 🙂 https://t.co/IHI3Os5qQ2
6: Dale Marruecos 🇲🇦
7: @PetterOficial13 Gifcard
8: Golazo de Croacia, empató Marruecos 🤣 #Qatar2022
9: A bueno... 1-1
10: @conservcorner1 @micheleconunaL @WalmartMXyCAM Pues yo no entro a un lugar donde me exijan mascarilla. Punto
Show the code
st <- stream_tweets(q = "Soccer World Cup", timeout = 30,
file_name = "data/stream_tweets32907e436248.json")Show the code
st <- ndjson::stream_in("data/stream_tweets32907e436248.json")
st %>%
slice_sample(n = 10) %>%
select(text) text
1: Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/ROtDmoKmzd
2: Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/0taaWJfyVd
3: RT @waynojam: 🔴𝐆𝐨 𝐎𝐧 𝐋𝐢𝐯𝐞📺@foxsportsfreetv\n\nWatch 2022 FIFA World Cup Football/Soccer Third-Place Play-off Game Live Streams Online Free\n\n🔴…
4: Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/t5HoH7BMwV
5: Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/Wy6FfA5PLk
6: RT @waynojam: 🔴𝐆𝐨 𝐎𝐧 𝐋𝐢𝐯𝐞📺@foxsportsfreetv\n\nWatch 2022 FIFA World Cup Football/Soccer Third-Place Play-off Game Live Streams Online Free\n\n🔴…
7: Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/yDIaCs9gwc
8: Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/tLkCVIRzdo
9: Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/aU3F9thVNw
10: Fernanda Quiroga still remembers how Lionel Messi played soccer in what were then dirt roads. https://t.co/X5Bm9izpf7
Show the code
iran <- stream_tweets(q = "Iran", timeout = 30,
file_name = "data/iran.json")Show the code
iran <- ndjson::stream_in("data/iran.json")
iran %>%
slice_sample(n = 10) %>%
select(text) text
1: RT @G_Dallemagne: Je suis le parrain politique de l’étudiante MAHSA MOHAMMADI. Enlevée par des milices de la rép. islamique d’Iran il y a 6…
2: RT @NatalieAmiri: Die Islamische Republik braucht keine Sittenpolizei. Sie haben noch viele noch viel schlimmere Schergen, die den Frauen d…
3: 🔴Llamamiento de @ispsoe para detener la ejecución del futbolista iraní Amir Nasr-Azadani\n👉🏽Instan a todos los gobie… https://t.co/JgrMffqEgC
4: RT @fasc1nate: A stunning color pencil shop in Tehran, Iran https://t.co/NGwZsa9PTc
5: از حمایت بشردوستان جهان بخصوص آقای @JamesCleverly از #انقلاب۱۴۰۱ سپاسگزاریم.\n\n#مهسا_امینی\n#StopExecutionInIran… https://t.co/1PI6gyHjBf
6: RT @Irandokht_60: @elonmusk Elon please throw Islamic regime's leaders out of Twitter.\nThey have filtered Twitter in Iran, to kill Iranians…
7: RT @fargosi: El Gobierno, la Cancillería, la Secretaría de DDHH y el colectivo verde, no condenan la ejecución de un jugador iraní por apoy…
8: RT @Taheri_Movement: Der Präsident der Ärztekammer Hamburg Dr. med. @emami_p\n übernimmt eine Patenschaft für den im Iran zum Tode verurteil…
9: RT @G_Dallemagne: Je suis le parrain politique de l’étudiante MAHSA MOHAMMADI. Enlevée par des milices de la rép. islamique d’Iran il y a 6…
10: RT @EndGameWW3: Iran's Nuclear Chief Says Uranium Enrichment 'More Than Doubled'\nhttps://t.co/qS0Qc2FigF
Druge rtweet funkcije:
search_users()
lookup_users()
get_trends()
stream_tweets()
lists_members()
lists_statuses()
lookup_coords()
tweet_shot()
post_*()
ts_data()
lat_lng()
emojis
stopwordslangs
4.2.2.8 Analiza omrežja
Analiza in upodobitev omrežij s knjižnico igraph:
https://kateto.net/netscix2016.html
Show the code
## get friends of multiple accounts
fds <- get_friends(c("nmusar", "anzelog", "tfajon"),
retryonratelimit = TRUE)
## frequency count of accounts followed by the users queried above
tbl <- table(fds$from_id)
## subset fds data to only those followed by 5 or more
fds3 <- subset(fds, from_id %in% names(tbl[tbl > 15L]))
fds3_names <- lookup_users(fds3$to_id)
fds3_names <- fds3_names %>%
rename(to_id = id_str)
fds3_names <- fds3_names %>%
select(to_id, name)
fds3 <- fds3 %>% left_join(fds3_names, by = "to_id")
fds3 <- fds3 %>% select(1,3,2)
## convert fds3 to matrix
mat <- as.matrix(fds3)
saveRDS(mat, "data/mat.rds")
fds3 <- fds3 %>% select(1,2)
## convert fds3 to matrix
mat <- as.matrix(fds3)
saveRDS(mat, "data/mat.rds")
## convert to graph object
mat <- igraph::graph_from_edgelist(mat, directed = TRUE)
saveRDS(mat, "data/mat_igraph.rds")Show the code
mat <- read_rds("data/mat_igraph.rds")Show the code
matIGRAPH c75d01a DN-- 4454 5865 --
+ attr: name (v/c)
+ edges from c75d01a (vertex names):
[1] nmusar->Dejan 🧬✍️ 📷 🏃🇸🇮 nmusar->Dejan 🧬✍️ 📷 🏃🇸🇮
[3] nmusar->Emmanuel Macron nmusar->Emmanuel Macron
[5] nmusar->Emmanuel Macron nmusar->President of Ireland
[7] nmusar->Klaus Iohannis nmusar->President of Malta
[9] nmusar->Katrín Jakobsdóttir nmusar->Vesna Pusić
[11] nmusar->Vesna Pusić nmusar->Bajram Begaj
[13] nmusar->Buitengebieden nmusar->Ingrida Šimonytė
[15] nmusar->Albin Kurti nmusar->Albin Kurti
+ ... omitted several edges
Show the code
# head(mat)
# mat[]Show the code
V(mat)$name[1:5][1] "nmusar" "Dejan 🧬✍️ 📷 🏃🇸🇮" "Emmanuel Macron"
[4] "President of Ireland" "Klaus Iohannis"
Show the code
## plot network
# plot(mat)
plot(mat, layout = layout_nicely(mat),
edge.arrow.size=.25, vertex.color="gold", vertex.size=5,
vertex.frame.color="gray", # vertex.shape = "none",
vertex.label.color=c("pink","skyblue"), edge.curved=0.2,
vertex.label.cex=0.3, vertex.label.dist=5)
Show the code
mats <- simplify_and_colorize(mat)
mats <- delete_edges(mats, which(E(mats)$weight <= 0.1)) # condition
mats <- delete_vertices(mats, which(degree(mats) <= 1)) # condition
plot(mats, layout = layout_nicely(mats), vertex.size=5)
Show the code
mats <- simplify(mat, remove.multiple = T,
remove.loops = F,
edge.attr.comb=c(weight="sum",
type="ignore"))
mats <- delete_edges(mats, which(E(mats)$weight <= 0.1)) # condition
mats <- delete_vertices(mats, which(degree(mats) <= 1)) # condition
plot(mats, vertex.label.dist=1.5, vertex.label = NA)
Pretvori povezave (edge) in vozlišča (vertex) v tabele (dataframe).
Show the code
as_data_frame(mat, what="edges") %>% rmarkdown::paged_table()Show the code
as_data_frame(mat, what="vertices") %>% rmarkdown::paged_table()4.2.2.9 Sentimentna analiza
4.2.3 Že opravljene poizvedbe
4.2.3.1 Časovnice
Časovnice slovenskih politikov na Twitterju.
Show the code
seznam_polit <- list.files(path = "data/twitter/politiki/",
pattern = "_2022-12-16.rds",
full.names = TRUE)
seznam_imen <- str_replace(
seznam_polit,
pattern = "(^.*politiki/)(.*)(_time.*.rds$)",
replacement = "\\2")
politiki_df <- NULL
for(i in 1:length(seznam_polit)){
x <- read_rds(seznam_polit[i]) %>%
mutate(author = seznam_imen[i])
politiki_df <- bind_rows(politiki_df, x)
}
write_xlsx(politiki_df,
"data/twitter/politiki/twitter_politiki_df.xlsx")
dim(politiki_df)[1] 23829 44
Show the code
politiki_df %>%
group_by(created_at, author) %>%
count(author, sort = TRUE) %>%
ungroup() %>%
group_by(author) %>%
filter(created_at > "2018-01-01") %>%
ts_plot("weeks", color = "blue") +
labs(x = "", y = "") +
facet_wrap(~ author, scales = "free_y")
Show the code
p1 <- politiki_df %>%
filter(created_at > "2018-01-01") %>%
group_by(author) %>%
ts_plot("days", color = "red") +
theme_minimal() +
theme(plot.title = ggplot2::element_text(face = "bold")) +
labs(
x = NULL, y = NULL,
title = "Frequency of Twitter statuses",
subtitle = "Twitter status (tweet) counts aggregated using week intervals",
caption = "\nSource: Data collected from Twitter's REST API via rtweet"
) +
facet_wrap(~ author, scales = "free_y")
library(plotly)
ggplotly(p1)4.2.3.2 Jeziki
Preštej jezike:
Show the code
politiki_df %>%
count(lang, sort = TRUE)# A tibble: 41 × 2
lang n
<chr> <int>
1 sl 19176
2 en 2727
3 und 950
4 cs 147
5 zxx 137
6 qme 121
7 es 79
8 pl 60
9 fr 42
10 in 42
# … with 31 more rows
Izberi samo čivke v slovenščini:
Show the code
politiki_df <- politiki_df %>%
filter(lang == "sl")
dim(politiki_df)[1] 19176 44
4.2.3.3 Vsota besed (tokens)
Vsota besed (tokens), najdaljši in najkrajši čivki.
Show the code
politiki_tokens_sum <- politiki_df %>%
group_by(author) %>%
summarise(tokens_sum = sum(ntoken(text)),
tokens_min = min(ntoken(text)),
tokens_max = max(ntoken(text)),
char_max = max(nchar(text))) %>%
arrange(-tokens_sum)
politiki_tokens_sum %>% rmarkdown::paged_table()4.2.3.4 Povprečna dolžina čivka
Koliko besed (z ločili in simboli vred) čivkajo politiki v povprečju?
Show the code
politiki_token_mean <- politiki_df %>%
group_by(author) %>%
summarise(median_token = median(ntoken(text)),
mean_token = mean(ntoken(text)),
sd_token = sd(ntoken(text))) %>%
arrange(-mean_token)
politiki_token_mean# A tibble: 8 × 4
author median_token mean_token sd_token
<chr> <dbl> <dbl> <dbl>
1 fajon 27 31.2 11.4
2 jckralj 27 30.3 10.3
3 mesec 27 29.5 12.6
4 tonin 25 26.2 7.68
5 alogar 25 25.0 6.71
6 jansa 25 23.8 7.20
7 npmusar 21 23.7 13.8
8 zturk 20 21.7 11.5
4.2.3.5 Povedi
Show the code
politiki_povedi <- politiki_df %>%
unnest_tokens(poved, text, "sentences")Show the code
politiki_povedi %>%
group_by(author) %>%
summarise(median_sent = median(ntoken(poved)),
mean_sent = mean(ntoken(poved)),
sd_sent = sd(ntoken(poved)),
char_sent = mean(nchar(poved))) %>%
arrange(-mean_sent)# A tibble: 8 × 5
author median_sent mean_sent sd_sent char_sent
<chr> <dbl> <dbl> <dbl> <dbl>
1 jckralj 14 15.1 9.12 88.4
2 mesec 13 14.7 9.58 78.6
3 tonin 14 14.3 8.38 80.4
4 fajon 12 13.8 8.78 79.4
5 jansa 12 13.2 8.14 72.5
6 alogar 12 12.9 8.20 73.2
7 zturk 10 11.9 7.55 63.7
8 npmusar 9 10.9 7.00 60.8
4.2.3.6 Ngrami
Show the code
politiki_ngrams <- politiki_df %>%
unnest_tokens(ngram, text, "ngrams", n = 2)Show the code
politiki_ngrams %>%
group_by(author) %>%
count(ngram, sort = TRUE)# A tibble: 289,152 × 3
# Groups: author [8]
author ngram n
<chr> <chr> <int>
1 jckralj https t.co 1145
2 fajon https t.co 1106
3 fajon rt strankasd 966
4 npmusar https t.co 832
5 zturk https t.co 710
6 jansa https t.co 694
7 alogar https t.co 643
8 tonin https t.co 557
9 tonin rt novaslovenija 527
10 mesec https t.co 447
# … with 289,142 more rows
4.2.3.7 Besede
Show the code
politiki_besede <- politiki_df %>%
unnest_tokens(word, text, "words")Show the code
politiki_besede %>%
group_by(author) %>%
count(word, sort = TRUE)# A tibble: 101,633 × 3
# Groups: author [8]
author word n
<chr> <chr> <int>
1 tonin rt 2313
2 jckralj v 2179
3 jckralj in 2162
4 jansa rt 2109
5 alogar rt 2061
6 fajon in 2017
7 fajon v 1961
8 jckralj za 1932
9 jckralj rt 1691
10 fajon rt 1583
# … with 101,623 more rows
Pogovori o ukrepih proti covidu
Pogovori o vojni v Ukrajini
4.3 Označevanje in lematizacija besed v podnapisih
4.3.1 Prilaganje podnapisov
Za jezikovno gradivo izberemo podnapise filma Avatar, ki so bili prevedeni v slovenščino. Primerjave podnapisov v več jezikih najdete v spletni knjigi Petrič 2022
Show the code
avatar_slv <- read_lines("data/sub/Avatar_slv.txt")
head(avatar_slv, 10) [1] ""
[2] "1"
[3] "00:00:38,160 --> 00:00:40,720"
[4] "<i>Ko sem ležal v veteranski bolnišnici</i>"
[5] ""
[6] "2"
[7] "00:00:40,755 --> 00:00:43,280"
[8] "<i>z veliko praznino v svojem življenju,</i>"
[9] ""
[10] "3"
Podnapisi nimajo primerne oblike za jezikovno analizo. Potrebujemo le vrstice z dialogom. Le-te želimo pretvoriti v obliko tabele, kar nam omogoča oblikovanje in analizo besedila s programskimi funkcijami tidyverse ali quanteda.
Show the code
c1 = avatar_slv %>%
as_tibble() %>%
mutate(row_tc = row_number()) %>%
filter(str_detect(value, "-->")) %>%
rename(timecode = value)
c2 = avatar_slv %>%
as_tibble() %>%
mutate(row_id = row_number()) %>%
filter(str_detect(value, "[a-zA-Z]")) %>%
rename(text = value) %>%
mutate(text = str_replace(text, "\\<i\\>", "")) %>%
mutate(text = str_replace(text, "\\</i\\>", "")) %>%
mutate(language = "slv")
# avatar_slv = bind_cols(a1,a2)
# select(timecode, text) %>%
# separate(timecode, into = c("start", "end"), sep = "\\-\\-\\>")
# tail(avatar_slv)
avatxt = c2 %>%
# opcija: dodaj stolpec s prvotnimi številkami vrstic v podnapisih
mutate(sentence_id = row_number()) %>%
# regex: odstrani pomišljaj pred besedo
mutate(text = str_replace(text, "(–)([a-zA-Z蚞ȊŽ]+)", "\\2"))
head(avatxt)# A tibble: 6 × 4
text row_id language sentence_id
<chr> <int> <chr> <int>
1 Ko sem ležal v veteranski bolnišnici 4 slv 1
2 z veliko praznino v svojem življenju, 8 slv 2
3 sem začel sanjati o letenju. 12 slv 3
4 Bil sem svoboden. 16 slv 4
5 Toda prej ali slej se moraš zbuditi. 20 slv 5
6 V kriospanju sploh ne sanjaš. 24 slv 6
4.3.2 Uporaba udpipe
Za označevanje (POS Tagging) in lematizacijo besedilnih enot nam je več knjižnic na razpolago, najpogosteje uporabljeni pa sta spacyr in udpipe. Knjižnica spacyr zahteva namestitev programskih knjižnic v jeziku Python in za zdaj ne omogoča označevanja slovenskih besednih oblik. To sta dva tehtna razloga za uporabo knjižnice udpipe.
Najprej si moramo priskrbeti jezikovni model za slovenščino z interneta. V sledečem programskem odstavku R preverja, ali je navedena datoteka (destfile = …) že v delovni mapi. Če je še ni, potem jo potegne s privzetega strežnika na računalnik. Če je jezikovni model že v delovni mapi, preskoči nalaganje z interneta in naloži model z diska v delovni pomnilnik računalnika.
Show the code
library(udpipe)
destfile = "slovenian-ssj-ud-2.5-191206.udpipe"
if(!file.exists(destfile)){
jezikovni_model <- udpipe_download_model(language = "slovenian")
udmodel_sl <- udpipe_load_model(jezikovni_model$file_model)
} else {
file_model = destfile
udmodel_sl <- udpipe_load_model(file_model)
}Naslednji programski odstavek vsebuje funkcijo tipa “Sam svoj mojster” 🤔. Lastnoročna izdelana funkcija poskrbi za to, da tabeli dodamo več stolpcev, ki vsebujejo označbe besednih oblik in količine za merjenje dolžine besed ali povedi.
Show the code
tokenize_annotate = function(tbl){
tbl %>%
unnest_tokens(word, token, drop = F) %>%
cbind_morphological(term = "feats",
which = c("PronType","NumType","Poss","Reflex",
"Foreign","Abbr","Typo",
"Gender","Animacy","NounClass",
"Case","Number","Definite","Degree",
"VerbForm","Person","Tense","Mood",
"Aspect","Voice","Evident",
"Polarity","Polite","Clusivity")) %>%
mutate(txt = str_replace_all(sentence, "[:punct:]", "")) %>%
mutate(sentlen = quanteda::ntoken(txt)) %>%
mutate(syllables = nsyllable::nsyllable(txt)) %>%
mutate(types = quanteda::ntype(txt)) %>%
mutate(wordlen = syllables/sentlen) %>%
mutate(ttr = types/sentlen) %>%
select(-txt, -feats)
}Po potrebi lahko poskrbimo tudi za ohranitev stolpcev iz prvotne tabele, ki bi se sicer v procesu označevanja besedilnih enot izgubile.
Show the code
# keep columns of interest
# these columns will be fed into doc_id of udpipe
# afterwards the doc_id column will be separated
keepcol <- paste(avatxt$row_id, avatxt$language,
sep = "_")Programski odstavek, ki poskrbi za označevanje besednih oblik.
Show the code
udp <- udpipe_annotate(
# jezikovni model za slovenščino
object = udmodel_sl,
# izbrani podnapisi
x = as.character(avatxt$text),
# opcija: prilagodimo doc_id
doc_id = as.character(keepcol),
# pokaže potek označevanja, če TRUE
trace = TRUE)
udp <- as.data.frame(udp)
udpiped <- udp %>%
# gornja lastnoročna izdelana funkcija
tokenize_annotate() %>%
# oblikovanje vsebine stolpcev
mutate(token_id = as.numeric(token_id),
head_token_id = as.numeric(head_token_id)) %>%
# razdeli stolpec doc_id na več novih
separate(doc_id,
into = c("row_id", "language"),
sep = "_", extra = "merge")
# shrani tabelo v varčni obliki (le R zna brati take datoteke)
saveRDS(udpiped, "data/avatar_slv_udpiped.rds")Da malo pospešimo delo, bomo kar naložili že pripravljeno datoteko z diska.
Show the code
udpiped <- read_rds("data/avatar_slv_udpiped.rds")
head(udpiped, 3) %>% rmarkdown::paged_table()4.3.3 Besedne vrste
Katere besedne vrste in koliko pojavnic je program prepoznal?
Show the code
bes_vrste <- udpiped %>%
count(upos, sort = T) %>%
mutate(pct = round(100*n/sum(n), 2))
bes_vrste %>%
rmarkdown::paged_table()Show the code
bes_vrste %>%
# izloči ločila in neznano besedno vrsto
filter(!upos %in% c("X", "PUNCT")) %>%
# razvrščaj besedne vrste po odstotkih
mutate(upos = fct_reorder(upos, pct)) %>%
# pct delimo s 100, ker bomo spodaj uveljavili "percent_format"
ggplot(aes(pct/100, upos, color = upos)) +
# nariši črte
geom_segment(aes(x = 0, xend = pct/100, y = upos, yend = upos)) +
# dodaj pike oz. bucke
geom_point(size = 3) +
# uporabi oblikovalno predlogo
theme_light() +
# uveljavi oblikovanje x osi (enota je odstotek)
scale_x_continuous(labels = percent_format(accuracy = 1)) +
# imena osi niso potrebna
labs(x = "", y = "") +
# odstrani legendo
theme(legend.position = "none")Error in percent_format(accuracy = 1): could not find function "percent_format"
4.3.4 Samostalniki
Kateri samostalniki so bili najpogosteje uporabljeni v podnapisih?
Show the code
samostalniki <- udpiped %>%
# izberi le samostalnike
filter(upos == "NOUN") %>%
# opcija: samo male črke
# mutate(lemma = tolower(lemma)) %>%
# preštej in razvrščaj
count(lemma, sort = T) %>%
# dodaj stolpec z odstotki
mutate(pct = round(100*n/sum(n), 2))
samostalniki %>%
rmarkdown::paged_table()Show the code
samostalniki %>%
# razvrščaj slovarske enote glede na odstotkovno pogostnost
mutate(lemma = fct_reorder(lemma, pct)) %>%
# pokaži samo prvih 20
head(20) %>%
ggplot(aes(pct/100, lemma, color = lemma)) +
# nariši črto
geom_segment(aes(x = 0, xend = pct/100, y = lemma, yend = lemma)) +
# nariši točko oz. bucko
geom_point(size = 3) +
# izberi oblikovalno predlogo
theme_light() +
# x os naj ima odstotke kot enoto
scale_x_continuous(labels = percent_format(accuracy = 1)) +
# brez imen osi
labs(x = "", y = "") +
# brez legende
theme(legend.position = "none")Error in percent_format(accuracy = 1): could not find function "percent_format"
S funkcijo xray() knjižnice quanteda.textplots lahko pokažemo, v katerih vrsticah podnapisov (ki ima 1606 vrstic) se pojavljajo izbrane besede, npr. imena glavnih likov filma.
Show the code
textplot_xray(
kwic(avatxt %>% pull(text),
pattern = c("Grace","Tsu'tey")),
scale = "relative")
V katerih oblikah in v katerih vrsticah podnapisov nastopa slovarska enota (lemma) brat?
Show the code
udpiped %>%
# izberi vrstice s slovarsko enoto "brat"
filter(lemma == "brat") %>%
# izberi stolpce za prikaz
select(sentence, token, lemma, upos, xpos, dep_rel) %>%
rmarkdown::paged_table()Z naslednjo poizvedbo želimo najti samostalnike v množinski obliki.
Show the code
#Find all plural nouns (tokens)
udpiped %>%
# nastavimo ustrezne filtre za izbor vrstic tabele
filter(language == "slv" & # tu nepotrebno, ker imamo samo slv
upos == "NOUN" &
morph_number == "Plur") %>%
select(sentence, token, lemma, upos, xpos, morph_number) %>%
rmarkdown::paged_table()V sledečem programskem odstavku sestavljamo tabelo o pogostnosti edninskih množinskih in dvojinskih oblik samostalnikov.
Show the code
udpiped %>%
# izberemo relevantne stolpce
dplyr::select(language, token, lemma, upos, morph_number) %>%
# tu ni potrebno, ker imamo samo slv podnapise
group_by(language) %>%
# izbere le vrstice s samostalniki
filter(upos == "NOUN") %>%
# preštej vrstice v stolpcu o številu
count(morph_number) %>%
# preoblikuj tabelo iz dolge v široko obliko (lažje beremo)
pivot_wider(names_from = language, values_from = n) %>%
# mutate(across(everything(), ~ replace_na(.x, 0))) %>%
# v vseh stolpcih zamenjaj NA z ničlo
mutate_if(is.numeric, ~ replace_na(.x, 0)) %>%
# v stolpcu zamenjaj črkovni niz "0" z opisno vrednostjo "Unknown"
mutate(morph_number =
str_replace(morph_number, "0", "Unknown")) %>%
# uredi stopnje v kategoriji število po zaznamovanosti
mutate(morph_number =
fct_relevel(
morph_number, levels =
c("Sing","Plur","Dual","Unknown"))) %>%
# dodal naknadno: odstotke
mutate(pct = round(100*slv/sum(slv), 2)) %>%
# razvrščaj po stopnjah kategorije število
arrange(morph_number) %>%
rmarkdown::paged_table()4.3.5 Pridevniške oblike
Show the code
udpiped %>%
# grupiranje tu ni potrebno, ker imamo samo slv podnapise
group_by(language) %>%
# izbor jezikov tu ni potreben
filter(language == "eng" |
language == "deu" | language == "slv") %>%
# izberi le vrstice s pridevniki
filter(upos == "ADJ") %>%
# preštej stopnjevalne oblike in razvrščaj
count(morph_degree, sort = TRUE) %>%
# dodaj stolpec z odstotki
mutate(pct = round(100*n/sum(n),2)) %>%
# preoblikuj dolgo tabelo v široko obliko
pivot_wider(names_from = language, values_from = c(n, pct)) %>%
# mutate(across(everything(), ~ replace_na(.x, 0))) %>%
# v vseh stolpcih zamenjaj NA z ničlo
mutate_if(is.numeric, ~ replace_na(.x, 0)) %>%
# v stolpcu zamenjaj niz "0" z opisom "Unknown"
mutate(morph_degree =
str_replace(morph_degree, "0", "Unknown")) %>%
# uredi vrstni red stopnjevalnih stopenj pridevnikov
mutate(morph_degree =
fct_relevel(
morph_degree, levels =
c("Pos","Cmp","Sup","Abs","Unkown"))) %>%
# razvrščaj
arrange(morph_degree) %>%
rmarkdown::paged_table()4.3.6 Skladenjske analize
4.3.6.1 UD shema
Tipološke za označevanje besedilnih enot: Universal Stanford Dependencies: A cross-linguistic typology (de Marneffe et al. 2014).
Show the code
knitr::include_graphics("pictures/Screenshot 2021-08-27 at 12-14-22 Universal Dependency Relations.png")
4.3.6.2 Dependenčni odnosi
V naslednjem programskem odstavku sestavljamo tabelo za prikaz skladenjskih prvin po kategorijah UD (gl. zgoraj), in sicer na enak način kot v prejšnjih odstavkih (gl. pojasnila tam).
Show the code
udpiped %>%
group_by(language) %>%
filter(language == "eng" |
language == "deu" | language == "slv") %>%
count(dep_rel, sort = TRUE) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = language, values_from = c(n, pct)) %>%
# mutate(across(everything(), ~ replace_na(.x, 0))) %>%
mutate_if(is.numeric, ~ replace_na(.x, 0)) %>%
mutate(dep_rel =
str_replace(dep_rel, "0", "Unknown")) %>%
rmarkdown::paged_table()Koren odvisnostnega odnosa (root of dependency relation) nam pove, ali je bilo zaporedje besed identificirano kot stavek. Običajno se določi s pomočjo (osebne) glagolske oblike v stavku. V eliptičnih stavkih je ena od besednih oblik, ki se pojavi, povezana s korenom.
Iz tabele (gl. root, koren) je razvidno, da je v slovenskih podnapisih prepoznanih 1807 stavčnih enot.
Naslednji programski odstavek vsebuje lastnoročno izdelano funkcijo za risanje dependenčnih odnosov v stavkih. Prevzeli smo jo od poišči, potem pa prilagodili našim potrebam. Spodaj jo bomo videli v akciji.
Show the code
library(igraph)
library(ggraph)
library(ggplot2)
plot_annotation <- function(x, size = 3){
stopifnot(is.data.frame(x) & all(c("sentence_id", "token_id", "head_token_id", "dep_rel", "token_id", "token", "lemma", "upos", "xpos", "feats") %in% colnames(x)))
x <- x[!is.na(x$head_token_id), ]
x <- x[x$sentence_id %in% min(x$sentence_id), ]
edges <- x[x$head_token_id != 0, c("token_id", "head_token_id", "dep_rel")]
edges$label <- edges$dep_rel
g <- graph_from_data_frame(edges,
vertices = x[, c("token_id", "token", "lemma", "upos", "xpos", "feats")],
directed = TRUE)
windowsFonts("Arial Narrow" = windowsFont("Arial"))
ggraph(g, layout = "linear") +
geom_edge_arc(ggplot2::aes(label = dep_rel, vjust = -0.20),
arrow = grid::arrow(length = unit(4, 'mm'), ends = "last", type = "closed"),
end_cap = ggraph::label_rect("wordswordswords"),
label_colour = "red", check_overlap = TRUE, label_size = size) +
geom_node_label(ggplot2::aes(label = token), col = "darkgreen", size = size, fontface = "bold") +
geom_node_text(ggplot2::aes(label = upos), nudge_y = -0.35, size = size) +
theme_graph(base_family = "Arial Narrow") +
labs(title = "udpipe output", subtitle = "tokenisation, parts of speech tagging & dependency relations")
}Cilj naslednjega programskega odstavka je narisati diagram, ki prikazuje dependenčne odnose med stavčnimi prvinami. Stavek je iz slovenskih podnapisov za film Avatar.
Show the code
# Slovenian: v navednicah izbrani stavek
mytext = "Začel sem sanjati o letenju" %>%
# pretvori gornji niz po kodirni shemi utf8
enc2utf8()
# izberi stavek in jezikovni model in označuj oblike
x = udpipe(mytext, "slovenian")
# nariši oblikoskladenjsko označen stavek (gl. funkcijo zgoraj)
x3 = plot_annotation(x, size = 3)
x3
4.3.6.3 Osebki
Koliko osebkov najdemo s programom? Prilagodimo zgoraj že večkrat sestavljeno tabelo novi poizvedbi.
Show the code
udpiped %>%
group_by(language) %>%
filter(language == "eng" |
language == "deu" | language == "slv") %>%
filter(str_detect(dep_rel, "nsubj")) %>%
count(dep_rel, sort = TRUE) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = language, values_from = c(n, pct)) %>%
# mutate(across(everything(), ~ replace_na(.x, 0))) %>%
mutate_if(is.numeric, ~ replace_na(.x, 0)) %>%
mutate(dep_rel =
str_replace(dep_rel, "0", "Unknown")) %>%
rmarkdown::paged_table()Oglejmo si nekaj vrstic, ki vsebujejo osebek. Prekopiramo še eno tabelo, jo nekoliko prilagodimo novi poizvedbi.
Show the code
udpiped %>%
group_by(language) %>%
filter(language == "slv") %>%
filter(str_detect(dep_rel, "nsubj")) %>%
ungroup() %>%
select(sentence, sentence_id) %>%
distinct() %>%
head(5) %>% rmarkdown::paged_table()Izberimo vrstico neposredno iz tabele podnapisov in narišimo dependenčne odnose v izbranem stavku. Kako je osebek upodobljen v odvisnostnem diagramu?
Show the code
avatxt %>%
filter(language == "slv") %>%
filter(str_detect(text, "dobi svojega avatarja")) %>%
select(text) %>% rmarkdown::paged_table()Show the code
# Slovenian
mytext = "Vsak upravljavec dobi svojega avatarja" %>% enc2utf8()
x = udpipe(mytext, "slovenian")
x3 = plot_annotation(x, size = 3)
x3
4.3.6.4 Zaimki in samostalniki
Cilj naslednjega programskega odstavka je ugotoviti, v katerih stavčnih vlogah (osebek, tožilniški (strukturni) predmet, dajalniški predmet ali slovarsko določeni predmet) nastopajo zaimki in samostalniki. Prekopiramo zgoraj že večkrat uporabljeno tabelo in jo prilagodimo novim zahtevam.
Show the code
udpiped %>%
group_by(language) %>%
filter(upos == "NOUN" | upos == "PRON") %>%
filter(str_detect(dep_rel, "nsubj|obj|obl")) %>%
count(upos, dep_rel) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = language, values_from = c(n, pct)) %>%
# mutate(across(everything(), ~ replace_na(.x, 0))) %>%
mutate_if(is.numeric, ~ replace_na(.x, 0)) %>%
arrange(upos) %>%
rmarkdown::paged_table()Recikliramo tabelo, tokrat za prikaz števila in deležev osebkov z ozirom na zaimensko ali samostalniško obliko.
Show the code
udpiped %>%
group_by(language) %>%
filter(language == "eng" |
language == "deu" | language == "slv") %>%
filter(upos == "NOUN" | upos == "PRON") %>%
filter(str_detect(dep_rel, "nsubj")) %>%
count(upos, dep_rel) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = language, values_from = c(n, pct)) %>%
# mutate(across(everything(), ~ replace_na(.x, 0))) %>%
mutate_if(is.numeric, ~ replace_na(.x, 0)) %>%
arrange(upos) %>%
rmarkdown::paged_table()Izdelamo lastno (večkrat uporabno) funkcijo za pretvorbo dolgih tabel v široke tabele (ki jih ljudje lažje beremo).
Show the code
pivot_by_nsubj <- function(tbl) {
tbl %>%
filter(upos == "NOUN" | upos == "PRON") %>%
filter(str_detect(dep_rel, "nsubj")) %>%
count(upos, dep_rel) %>%
group_by(upos) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = upos, values_from = c(n, pct)) %>%
mutate_if(is.numeric, ~ replace_na(.x, 0))
# mutate(across(everything(), ~ replace_na(.x, 0)))
}
# uporabi gornjo funkcijo
x = udpiped %>%
filter(language == "slv") %>%
pivot_by_nsubj()
x %>% rmarkdown::paged_table()Oglejmo si nekaj primerov iz podnapisov filma Avatar, ki vsebujejo samostalnik ali zaimek v vlogi osebka!
Show the code
udpiped %>%
select(sentence, upos, dep_rel, language) %>%
filter(language == "slv") %>%
filter(upos == "NOUN" | upos == "PRON") %>%
filter(str_detect(dep_rel, "nsubj")) %>%
rmarkdown::paged_table()Prekopiramo tabelo in jo prilagodimo za prikaz pogostnosti tožilniškega predmeta v samostalniški ali zaimenski obliki.
Show the code
x = udpiped %>%
group_by(language) %>%
filter(upos == "NOUN" | upos == "PRON") %>%
filter(dep_rel == "obj") %>%
count(upos, dep_rel) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = language, values_from = c(n, pct)) %>%
# mutate(across(everything(), ~ replace_na(.x, 0))) %>%
mutate_if(is.numeric, ~ replace_na(.x, 0)) %>%
arrange(upos)
x %>% rmarkdown::paged_table()V naslednjem programskem odstavku sestavljamo preglednico za prikaz samostalnikov in zaimkov v vlogi osebka ali tožilniškega predmeta. Tabelo smo spet prekopirali in nekoliko prilagodili novim zahtevam.
Show the code
udpiped %>%
group_by(language) %>%
filter(upos == "NOUN" | upos == "PRON") %>%
filter(dep_rel == "nsubj" | dep_rel == "obj") %>%
count(upos, dep_rel) %>%
# group_by(upos) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = language, values_from = c(n, pct)) %>%
# mutate(across(everything(), ~ replace_na(.x, 0))) %>%
mutate_if(is.numeric, ~ replace_na(.x, 0)) %>%
arrange(upos) %>%
rmarkdown::paged_table()Lastnoročno izdelana funkcija v naslednjem programskem odstavku za pretvorbo dolge tabele v široko obliko je skoraj enaka kot malo prej sestavljena, razlika je le, da tokrat vključujemo osebke in preme (tožilniške) predmete.
Show the code
pivot_by_obj <- function(tbl) {
tbl %>%
filter(upos == "NOUN" | upos == "PRON") %>%
filter(dep_rel == "nsubj" | dep_rel == "obj") %>%
count(upos, dep_rel) %>%
group_by(upos) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = upos, values_from = c(n, pct)) %>%
mutate_if(is.numeric, ~ replace_na(.x, 0))
# mutate(across(everything(), ~ replace_na(.x, 0)))
}
# uporabi gornjo funkcijo
x = udpiped %>%
filter(language == "slv") %>%
pivot_by_obj()
x %>% rmarkdown::paged_table()S hi kvadrat preizkusom lahko ugotovimo neodvisnost (odvisnost) obeh vzorcev (samostalniškega in zaimenskega). V tem primeru je p vrednost manjša kot mejna vrednost (p < 0,05), tj. statistična značilna. Vzorca nista neodvisna: skladenjska vloga (osebek ali predmet) je povezana s besedno vrsto (zaimek ali samostalnik)
Show the code
# Base-R
hi <- chisq.test(x[,c(2:3)])
hi
Pearson's Chi-squared test with Yates' continuity correction
data: x[, c(2:3)]
X-squared = 71.069, df = 1, p-value < 2.2e-16
Show the code
# opazovane pogostnosti
hi$observed n_NOUN n_PRON
[1,] 192 57
[2,] 175 231
Show the code
# pričakovane pogostnosti po ničelni domnevi (tj. da ni razlike med vzorcema oz. da sta vzorca neodvisna)
hi$expected n_NOUN n_PRON
[1,] 139.516 109.484
[2,] 227.484 178.516
V spletni knjigi Petrič 2022 je še več skladenjskih analiz s programom udpipe, ki si jih lahko ogledate (npr. besedni vrstni red v samostalniških besednih zvezah ali stavkih).
4.4 Označevanje: YouTube
4.4.1 Preberi in združi
Sledeče podatkovne nize smo pridobili s pomočjo YouTube Data Tools (https://tools.digitalmethods.net/netvizz/youtube/). Orodje je sprogramiral “Bernhard Rieder […] an associate professor in New Media and Digital Culture at the University of Amsterdam and a researcher with the Digital Methods Initiative.” (http://thepoliticsofsystems.net/about/).
Dva video posnetka na portalu YouTube sta povezana z znanima slovenskima politikoma, Zoranom Jankovićem in Janezom Janšo. Gledalci oddaje 24 ur so po ogledu oddali svoje pripombe. V tretjem video posnetku (file = 2) je novinarka spraševala ljudi, kaj delajo za božič. Gledalci so po ogledu oddali svoje pripombe.
Show the code
gpath <-list.files(path = "data/youtube/",
pattern = "_comments.csv",
full.names = TRUE)
comments <- map_dfr(gpath, read_csv, .id = "file") %>%
# dodelimo vsaki datoteki prepoznavno ime
# namesto ifelse() uporabljamo case_when()
mutate(file = case_when(
file == "1" ~ "24ur_Jansa",
file == "2" ~ "24ur_bozic",
file == "3" ~ "24ur_Jankovic",
TRUE ~ "other"
))
names(comments) [1] "file" "id" "replyCount" "likeCount"
[5] "publishedAt" "authorName" "text" "authorChannelId"
[9] "authorChannelUrl" "isReply" "isReplyTo" "isReplyToName"
4.4.2 Nezaželene besede
Show the code
stop_sl <- quanteda::stopwords(language = "sl",
source = "stopwords-iso")
stop_sl <- c(quanteda::stopwords(language = "sl",
source = "stopwords-iso"),
"\n", " ", "[\\d]+", "quot", "še", "^www.+", "^http.+",
"search_query")
stop_sl_tidy <- stop_sl %>% as_tibble() %>% rename(word = value)
# remove stopwords and punctuation and digits
stop_sl_collapsed <- paste0(paste0('\\b', stop_sl, '\\b',
collapse = "|"), '|[[:punct:]]+', "[\\d]+")
# another variant
stops <- paste0(stop_sl, collapse = "\\b|\\b")Nekaj naključno izbranih pripomb gledalcev.
Show the code
comments %>% slice_sample(n = 10)# A tibble: 10 × 12
file id reply…¹ likeC…² publishedAt autho…³ text autho…⁴ autho…⁵
<chr> <chr> <dbl> <dbl> <dttm> <chr> <chr> <chr> <chr>
1 24ur… Ugiv… NA 3 2020-03-27 22:06:51 Mark "Js … UCKw2M… http:/…
2 24ur… Ugxe… NA 0 2021-12-24 15:48:46 Mitja … "Gle… UCv5Aq… http:/…
3 24ur… Ugww… NA 1 2021-01-31 00:21:22 luksur… "@Al… UC02WL… http:/…
4 24ur… Ugyv… 0 1 2021-04-24 22:29:14 matija "Zak… UC3jHx… http:/…
5 24ur… Ugxe… NA 0 2020-09-14 17:39:57 back2b… "202… UCmCz6… http:/…
6 24ur… Ugj7… NA 0 2021-06-15 19:46:35 TadeSLO "Za … UCyXOd… http:/…
7 24ur… Ugxd… NA 4 2021-03-01 22:11:07 Josko … "@AL… UCZMnW… http:/…
8 24ur… Ugyv… 0 0 2012-01-25 11:04:26 Sale G… "2pe… UCSTa6… http:/…
9 24ur… UgxM… NA 4 2021-02-24 20:46:22 ALES G… "@Ma… UCLJqG… http:/…
10 24ur… Ugx1… 0 0 2011-11-24 12:19:28 Polenar "bol… UCFbIx… http:/…
# … with 3 more variables: isReply <dbl>, isReplyTo <chr>, isReplyToName <chr>,
# and abbreviated variable names ¹replyCount, ²likeCount, ³authorName,
# ⁴authorChannelId, ⁵authorChannelUrl
4.4.3 Uporaba udpipe
Najprej naložimo jezikovni model za slovenščino v pomnilnik računalnika. Prekopiramo programski odstavek iz prejšnjega poglavja.
Show the code
library(udpipe)
destfile = "slovenian-ssj-ud-2.5-191206.udpipe"
if(!file.exists(destfile)){
jezikovni_model <- udpipe_download_model(language = "slovenian")
udmodel_sl <- udpipe_load_model(jezikovni_model$file_model)
} else {
file_model = destfile
udmodel_sl <- udpipe_load_model(file_model)
}Prekopiramo tudi programski odstavek z lastnoročno izdelano programsko funkcijo za prilagajanje in dopolnjevanje tabele.
Show the code
tokenize_annotate = function(tbl){
tbl %>%
unnest_tokens(word, token, drop = F) %>%
cbind_morphological(term = "feats",
which = c("PronType","NumType","Poss","Reflex",
"Foreign","Abbr","Typo",
"Gender","Animacy","NounClass",
"Case","Number","Definite","Degree",
"VerbForm","Person","Tense","Mood",
"Aspect","Voice","Evident",
"Polarity","Polite","Clusivity")) %>%
mutate(txt = str_replace_all(sentence, "[:punct:]", "")) %>%
mutate(sentlen = quanteda::ntoken(txt)) %>%
mutate(syllables = nsyllable::nsyllable(txt)) %>%
mutate(types = quanteda::ntype(txt)) %>%
mutate(wordlen = syllables/sentlen) %>%
mutate(ttr = types/sentlen) %>%
select(-txt, -feats)
}Naslednji trije programski odstavki (podobno kot v prejšnjem poglavju) poskrbijo za označevanje besednih oblik v prispevkih gledalcev YouTube video prispevka, dodajamo pa tudi stolpec za razlikovanje treh vzorcev.
Show the code
jansa <- comments %>% filter(file == "24ur_Jansa")
x = udpipe_annotate(udmodel_sl, x = jansa$text, trace = F)
jansa_ud = as.data.frame(x)
jansa_udpiped <- jansa_ud %>%
tokenize_annotate() %>%
mutate(file = "jansa") %>%
mutate(token_id = as.numeric(token_id),
head_token_id = as.numeric(head_token_id))Show the code
bozic <- comments %>% filter(file == "24ur_bozic")
x = udpipe_annotate(udmodel_sl, x = bozic$text, trace = F)
bozic_ud = as.data.frame(x)
bozic_udpiped <- bozic_ud %>%
tokenize_annotate() %>%
mutate(file = "bozic") %>%
mutate(token_id = as.numeric(token_id),
head_token_id = as.numeric(head_token_id))Show the code
janko <- comments %>% filter(file == "24ur_Jankovic")
x = udpipe_annotate(udmodel_sl, x = janko$text, trace = F)
janko_ud = as.data.frame(x)
janko_udpiped <- janko_ud %>%
tokenize_annotate() %>%
mutate(file = "jankovic") %>%
mutate(token_id = as.numeric(token_id),
head_token_id = as.numeric(head_token_id))Združujemo vzorce v eno tabelo.
Show the code
g_udpiped <- bind_rows(jansa_udpiped, bozic_udpiped, janko_udpiped)
dim(g_udpiped)Shranimo za kasnejšo ponovno uporabo, in sicer v varčni obliki rds. Te datoteke odpira le R.
Show the code
saveRDS(g_udpiped,
"data/youtube_comments_sl_jansa-bozic-jankovic.rds")Da prihranimo nekaj časa, prejšnjih pet odstavkov ni bilo izvedenih (#| eval: false). Zato datoteko v naslednjem odstavku naložimo v pomnilnik.
Show the code
g_udpiped <- read_rds("data/youtube_comments_sl_jansa-bozic-jankovic.rds")4.4.4 Glagoli
Na hitro poglejmo, kateri glagoli v prispevkih gledalcev prevladujejo.
V preglednici opazimo nekaj napak: besedila bi bilo treba sistematično pregledovati in popraviti najbolj moteče nepravilnosti kot npr. manjkajoč presledek za piko (npr. tega.Zelo) in očitne tipkovne napake gledalcev pri pisanju prispevkov (npr. jepostavil).
Show the code
g_udpiped %>%
filter(upos == "VERB") %>%
select(token, lemma, upos, xpos) %>%
rmarkdown::paged_table()Katere oblikoslovne oblike glagolov prevladujejo?
Show the code
g_udpiped %>%
filter(upos == "VERB") %>%
select(token, lemma, upos, xpos) %>%
count(xpos, sort = T) %>%
rmarkdown::paged_table()Ali se pogostnost glagolov razlikuje glede na tematiko video prispevka, ki so si ga gledalci ogledali?
Show the code
verbs_in_comments <- g_udpiped %>%
filter(upos == "VERB") %>%
filter(!str_detect(lemma, "^http")) %>%
filter(!str_detect(lemma, ";sti")) %>%
group_by(file) %>%
count(lemma, sort = T) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
pivot_wider(names_from = file, values_from = c(pct, n), values_fill = 0) %>%
arrange(-pct_jansa)
verbs_in_comments %>% rmarkdown::paged_table()Show the code
# write.csv2(verbs_in_comments, "data/youtube_sl_verbs_comments.csv")Pripombe gledalcev k trem oddajam v obliki besednih oblakov:
Show the code
library(ggwordcloud)
p0 <- g_udpiped %>%
filter(upos == "VERB") %>%
filter(!str_detect(lemma, "^http")) %>%
filter(!str_detect(lemma, ";sti")) %>%
group_by(file) %>%
count(lemma, sort = T) %>%
mutate(pct = round(100*n/sum(n),2)) %>%
slice_head(n = 40) %>%
ggplot(aes(pct/100, label = lemma, size = log(pct), color = pct)) +
geom_text_wordcloud() +
theme_light() +
scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(x="") +
facet_grid(~ file, scales = "free")
ggsave("pictures/youtube_comments_sl_verbs.png", dpi = 300,
width = 10, height = 4)
p0
Glagol biti je seveda najpogostejši glagol v vseh treh skupinah, vendar s precej višjim odstotkom v prispevkih o božiču. V pripombah k oddajam o politikoma poleg glagola biti izstopa predvsem glagol imeti. Mogoče se bo ta (pogostnostna) razlika pokazala tudi pri kolokacijah, pri katerih so sestavni del glagolske oblike.
Podoben pregled značilnih slovarskih enot bi lahko naredili tudi npr. za samostalnike in pridevnike.
Preštejmo še druge besede.
Show the code
# count words and remove numbers (if still present)
word_count <- g_udpiped %>%
count(word, sort = T, name = "Freq_word") %>%
filter(!str_detect(word, "[\\d]+"))
# Number of words
N <- nrow(word_count)Show the code
words_video <- g_udpiped %>%
group_by(file) %>%
# anti_join(stop_sl_tidy, by = "word") %>% # 6435 words
# filter(!str_detect(word, stop_sl_collapsed)) %>% # 6294 words
filter(!str_detect(word, stops)) %>% # 5278 words
count(word, sort = T) %>%
drop_na() %>%
group_by(file) %>%
mutate(pct = round(100*n/sum(n), 3))
dim(words_video)[1] 5286 4
Show the code
words_video %>%
pivot_wider(names_from = file, values_from = n,
values_fill = 0) %>%
ungroup()# A tibble: 5,286 × 5
word pct jansa jankovic bozic
<chr> <dbl> <int> <int> <int>
1 ales 0.981 48 0 0
2 edi 1.23 0 41 0
3 komunisti 0.572 28 0 0
4 ampak 0.552 27 0 0
5 let 0.687 0 23 0
6 pucer 0.687 0 23 0
7 zoki 0.657 0 22 0
8 sloveniji 0.45 22 0 0
9 tem 0.45 22 0 0
10 sloveniji 0.627 0 21 0
# … with 5,276 more rows
Show the code
library(ggwordcloud)
p1 <- words_video %>%
slice_head(n = 50) %>%
mutate(angle = 45 * sample(-2:2, n(), replace = TRUE,
prob = c(1, 1, 4, 1, 1))) %>%
ggplot(aes(label = word, size = pct, color = n), angle = angle) +
geom_text_wordcloud(shape = "circle", rm_outside = TRUE) +
scale_size_area(max_size = 20) +
# scale_radius(range = c(0, 16), limits = c(0, NA)) +
facet_wrap(~ file, scales = "free")
ggsave("pictures/youtube_sl_words_per_video.png", dpi = 300,
width = 10, height = 5)
p1
